R Notebook

Libraries

library(plotly)

Warning: package ‘plotly’ was built under R version 4.1.3Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 methods overwritten by 'htmltools':
  method               from         
  print.html           tools:rstudio
  print.shiny.tag      tools:rstudio
  print.shiny.tag.list tools:rstudio
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

Data

hb_agesex <- read.csv("raw_data/covid_raw_data/hospital_admissions_hb_agesex_20220302.csv") %>% clean_names()
hb_names <- read_csv("raw_data/covid_raw_data/health_board_names.csv") %>% clean_names()

Data exploration

HB Age/sex dataset

Variables in dataset

hb_agesex %>% names()

hb_agesex %>% head()

hb_agesex %>% distinct(hb)

The health board number is not very useful or easy to make connections with, we should change this to the name of the health board

#select only the columns with health board names
hb_names <- hb_names %>% 
  select(hb, hb_name)

#join to get health board names
hb_agesex <- hb_agesex %>% 
  left_join(hb_names, by = "hb")

#Fill in NAs in hb_name - these are NA because the code is the country code for NHS Scotland
hb_agesex <- hb_agesex %>% 
  mutate(hb_name = if_else(
    is.na(hb_name),
    "All Scotland",
    hb_name
  )) 

hb_agesex %>% 
  distinct(admission_type)

We have three different admission types (all, emergency, planned) - should we only be looking at emergency admission types (e.g. acute)?

hb_agesex %>% 
  distinct(hb)

hb_agesex %>% 
  distinct(week_ending)

#change week_ending into date format
hb_agesex <- hb_agesex %>% 
  mutate(week_ending = ymd(week_ending))

hb_agesex <- hb_agesex %>% 
  mutate(month = month(week_ending, label = TRUE),
         year = year(week_ending), .after = week_ending)

#create winter and non winter groups
hb_agesex <- hb_agesex %>% 
  mutate(is_winter = if_else(
    month %in% c("Dec", "Jan", "Feb"), TRUE, FALSE
  ), .after = month)

Exploratory analysis

Compare mean admissions between Covid times and pre-Covid times

#compare mean admissions in 2020/2021/2022 with 2018/2019 averages
hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group == "All ages",
         sex == "All") %>% 
  group_by(hb_name, week_ending) %>% 
  summarise(mean_admissions = mean(number_admissions),
            mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
    geom_line(aes(x = week_ending,
                  y = mean_admissions), group = 1, colour = "red") +
  geom_line(aes(x = week_ending,
                y = mean_20182019_admissions), group = 1, colour = "blue") +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
   geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4)+
  geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4)+
  geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4)+
  facet_wrap(~hb_name, scales = "free_y") + 
  labs(x = "Date",
       y = "Average admissions per week",
       colour = "Covid vs Pre-Covid")

Compare number of admissions between winter and non winter

No significant differences

#get boxplots to compare spread of number of admissions for winter vs not winter
hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group == "All ages",
         sex == "All",
         hb_name == "All Scotland") %>% 
  ggplot(aes(x = number_admissions,
             y = is_winter)) +
  geom_boxplot() +
  geom_jitter(colour = "grey30", alpha = 0.5) 
  

Not expecting significant difference

H0 - number of admissions(winter) = number of admissions(not winter) H1 - number of admissions(winter) > number of admissions(not winter)

null_distribution <- hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group == "All ages",
         sex == "All",
         hb_name == "All Scotland") %>% 
  specify(number_admissions ~ is_winter) %>% 
  hypothesise(null = "independence") %>% 
  generate(reps = 5000, type = "permute") %>% 
  calculate(stat = "diff in means", order = c("TRUE", "FALSE"))

observed_stat <- hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group == "All ages",
         sex == "All",
         hb_name == "All Scotland") %>% 
  specify(number_admissions ~ is_winter) %>% 
  calculate(stat = "diff in means", order = c("TRUE", "FALSE"))

null_distribution %>% 
  visualise() +
  shade_p_value(obs_stat = observed_stat, direction = "right")

p_value <- null_distribution %>% 
  get_p_value(obs_stat = observed_stat, direction = "right")

p_value

Compare mean number of admissions for winter/not winter for different HBs

No significant differences

hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group == "All ages",
         sex == "All",
         hb_name != "All Scotland") %>% 
  group_by(hb_name, is_winter) %>% 
  summarise(mean_num_admissions = mean(number_admissions)) %>% 
  ggplot(aes(x = hb_name,
             y = mean_num_admissions,
             fill = is_winter)) +
  geom_col(position = "dodge") +
  scale_y_sqrt()

`summarise()` has grouped output by 'hb_name'. You can override using the `.groups` argument.

NA

#compare percent variation for winter not winter
hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group == "All ages",
         sex == "All",
         hb_name == "All Scotland") %>% 
  ggplot(aes(x = percent_variation,
             y = is_winter)) +
  geom_boxplot() +
  geom_jitter(colour = "grey30", alpha = 0.5) 

Compare number of admissions by sex and winter/not winter

No significant differences

#get box plot for number of admissions by sex and whether or not it is winter
hb_agesex %>% 
  filter(sex != "All",
         admission_type == "Emergency",
         hb_name == "All Scotland") %>% 
  ggplot(aes(x = number_admissions,
             y = sex,
             colour = is_winter)) +
  geom_boxplot() +
  geom_jitter(colour = "grey30", alpha = 0.5)
  

#get bar graphs for mean number of admissions for each month by sex
hb_agesex %>% 
  filter(admission_type == "Emergency",
         sex != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, month, sex) %>% 
  summarise(mean_admissions = mean(number_admissions)) %>% 
  ggplot() +
    geom_col(aes(x = month,
                  y = mean_admissions, 
                  fill = sex), position = "dodge") 

`summarise()` has grouped output by 'hb_name', 'month'. You can override using the `.groups` argument.

hb_agesex %>% 
  filter(admission_type == "Emergency",
         sex != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, month, sex) %>% 
  summarise(mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
  geom_col(aes(x = month,
                  y = mean_20182019_admissions, 
                  fill = sex), position = "dodge")

`summarise()` has grouped output by 'hb_name', 'month'. You can override using the `.groups` argument.

Compare number of admissions for each age group for winter/not winter

For age groups over 65, admissions are slightly higher in the winter. The same pattern is not seen for younger age groups The increase in admissions in winter months for age groups over 65 was more drastic pre-Covid than during Covid. This is potentially due to the lockdown measures in winter Dec2020/Jan-Feb2021 and some remaining restrictions in winter Dec2021/Jan-Feb 2022 as well as the vaccination campaign targeting these age groups in early 2021 with boosters in late 2021/early 2022.

#get line graph of average number of admissions over time for each age group

hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group != "All ages", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, week_ending, age_group) %>% 
  summarise(mean_admissions = mean(number_admissions)) %>% 
  ggplot() +
    geom_line(aes(x = week_ending,
                  y = mean_admissions, 
                  colour = ordered(age_group, levels = c("Under 5",
                                                       "5 - 14",
                                                       "15 - 44",
                                                       "45 - 64",
                                                       "65 - 74",
                                                       "75 - 84",
                                                       "85 and over")))) +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
   geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4)+
  geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4)+
  geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4)+
  labs(x = "Month",
       y = "Average number of admissions per week",
       colour = "Age group")

#get line graph comparing pre-Covid admissions to Covid admissions for each age group
hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group != "All ages", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, month, age_group) %>% 
  summarise(mean_admissions = mean(number_admissions),
            mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
    geom_line(aes(x = month,
                  y = mean_admissions), group = 1, colour = "red") +
    geom_line(aes(x = month,
                  y = mean_20182019_admissions), group = 1, colour = "blue") +
    facet_wrap(~age_group)

hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group != "All ages", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, age_group, is_winter) %>% 
  summarise(mean_admissions = mean(number_admissions)) %>% 
  ggplot() +
    geom_col(aes(x = ordered(age_group, levels = c("Under 5",
                                                       "5 - 14",
                                                       "15 - 44",
                                                       "45 - 64",
                                                       "65 - 74",
                                                       "75 - 84",
                                                       "85 and over")),
                  y = mean_admissions, 
                  fill = is_winter), position = "dodge") 



hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group != "All ages", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, age_group, is_winter) %>% 
  summarise(mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
  geom_col(aes(x = ordered(age_group, levels = c("Under 5",
                                                       "5 - 14",
                                                       "15 - 44",
                                                       "45 - 64",
                                                       "65 - 74",
                                                       "75 - 84",
                                                       "85 and over")),
                  y = mean_20182019_admissions, 
                  fill = is_winter), position = "dodge")

Graphs for dashboard

#get bar graph for mean number of admissions for each month by sex
covid_sex_plotly <- hb_agesex %>% 
  filter(admission_type == "Emergency",
         sex != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, month, sex) %>% 
  summarise(mean_admissions = mean(number_admissions),
            mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
    geom_col(aes(x = month,
                  y = mean_admissions, 
                  fill = sex,
                 text = paste0("Month: ", month,
                              "<br>",
                   "Average number of admissions: ", 
                   round(mean_admissions),
                 "<br>",
                 "2018/2019 avg admissions: ", 
                 round(mean_20182019_admissions))), 
             position = "dodge") +
  labs(title = "Average admissions by month 2020 - 2022",
       x = "\n Month",
       y = "Mean number of admissions",
       fill = "Sex")

`summarise()` has grouped output by 'hb_name', 'month'. You can override using the `.groups` argument.Warning: Ignoring unknown aesthetics: text

covid_sex_plotly %>% 
  ggplotly(tooltip = "text") %>% 
  config(displayModeBar = FALSE) 

covid_age_plotly <- hb_agesex %>% 
  filter(admission_type == "Emergency",
         age_group != "All ages", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, age_group, is_winter) %>% 
  summarise(mean_admissions = mean(number_admissions),
            mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
  geom_col(aes(x = ordered(age_group, levels = c("Under 5",
                                                 "5 - 14",
                                                 "15 - 44",
                                                 "45 - 64",
                                                 "65 - 74",
                                                 "75 - 84",
                                                 "85 and over")),
               y = mean_admissions, 
               fill = if_else(is_winter == TRUE,
                              "Winter", "Not winter"),
               text = paste0("Age group: ", age_group,
                             "<br>",
                             "Average number of admissions: ", 
                             round(mean_admissions),
                             "<br>",
                             "2018/2019 avg admissions: ", 
                             round(mean_20182019_admissions))), 
           position = "dodge") +
  labs(title = "Average admissions by age group 2020 - 2022",
       x = "\n Age group",
       y = "Mean number of admissions",
       fill = "Season")

`summarise()` has grouped output by 'hb_name', 'age_group'. You can override using the `.groups` argument.Warning: Ignoring unknown aesthetics: text

covid_age_plotly %>% 
  ggplotly(tooltip = "text") %>% 
  config(displayModeBar = FALSE) 

HB SIMD dataset

Variables in dataset

hb_simd <- read_csv("raw_data/covid_raw_data/hospital_admissions_hb_simd_20220302.csv") %>% clean_names()

hb_simd %>% names(
)

HB Specialty dataset

Variables in dataset

hb_specialty <- read_csv("raw_data/covid_raw_data/hospital_admissions_hb_specialty_20220302.csv") %>% clean_names()

hb_specialty %>% names()

#join with hb_names to get hb names
hb_specialty <- hb_specialty %>% 
  left_join(hb_names, by = "hb")

#change week_ending into date format
hb_specialty <- hb_specialty %>% 
  mutate(week_ending = ymd(week_ending))

hb_specialty <- hb_specialty %>% 
  mutate(month = month(week_ending, label = TRUE),
         year = year(week_ending), .after = week_ending)

#create winter and non winter groups
hb_specialty <- hb_specialty %>% 
  mutate(is_winter = if_else(
    month %in% c("Dec", "Jan", "Feb"), TRUE, FALSE
  ), .after = month)

#impute NAs in hb_name with all scotland b/c these are only for the all scotland hb code
hb_specialty <- hb_specialty %>% 
  mutate(hb_name = if_else(
    is.na(hb_name),
    "All Scotland",
    hb_name
  )) 

Exploratory analysis

#get graph for winter vs non-winter means by specialty for emergency admissions 

hb_specialty %>% 
  filter(admission_type == "Emergency",
         specialty != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, specialty, is_winter) %>% 
  summarise(mean_admissions = mean(number_admissions)) %>% 
  ggplot() +
    geom_col(aes(x = specialty,
                  y = mean_admissions, 
                  fill = is_winter), position = "dodge") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) 



hb_specialty %>% 
  filter(admission_type == "Emergency",
         specialty != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, specialty, is_winter) %>%  
  summarise(mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
    geom_col(aes(x = specialty,
                  y = mean_20182019_admissions, 
                  fill = is_winter), position = "dodge") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) 

#get winter vs non-winter means by specialty for emergency admissions 

hb_specialty %>% 
  filter(admission_type == "Emergency",
         specialty != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, specialty, is_winter) %>% 
  summarise(median_admissions = median(number_admissions)) %>% 
  ggplot() +
    geom_col(aes(x = specialty,
                  y = median_admissions, 
                  fill = is_winter), position = "dodge") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) 



hb_specialty %>% 
  filter(admission_type == "Emergency",
         specialty != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, specialty, is_winter) %>%  
  summarise(mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
    geom_col(aes(x = specialty,
                  y = mean_20182019_admissions, 
                  fill = is_winter), position = "dodge") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) 

#grouped summary table by admission type
hb_specialty %>% 
  filter(specialty == "All",
         hb_name == "All Scotland") %>% 
  group_by(admission_type) %>% 
  summarise(mean_admissions_covid = mean(number_admissions),
            mean_admissions_precovid = mean(average20182019),
            diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid)

#grouped summary table by specialty and admission type for all Scotland
hb_specialty %>% 
  filter(specialty != "All",
         hb_name == "All Scotland",
         admission_type != "All") %>% 
  group_by(month, specialty, admission_type) %>% 
  summarise(mean_admissions_covid = mean(number_admissions),
            mean_admissions_precovid = mean(average20182019),
            diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid) %>% 
  ggplot() +
  geom_point(aes(x = month,
            y = mean_admissions_covid),
            colour = "red") +
  geom_line(aes(x = month,
            y = mean_admissions_covid),
            colour = "red", group = 1) +
  geom_point(aes(x = month,
            y = mean_admissions_precovid),
            colour = "blue") +
  geom_line(aes(x = month,
            y = mean_admissions_precovid),
            colour = "blue", group = 1) +
  facet_grid(rows = vars(specialty),
             cols = vars(admission_type), scales = "free_y")

#grouped summary table of mean admissions by hb, specialty and admission type for each month
hb_specialty %>% 
  filter(specialty != "All",
         hb_name != "All Scotland",
         admission_type != "All") %>% 
  group_by(hb_name, month, specialty, admission_type) %>% 
  summarise(mean_admissions_covid = mean(number_admissions),
            mean_admissions_precovid = mean(average20182019),
            #get diff in means precovid vs during covid
            diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid) %>% 
  #see only observations where the mean admissions increased during covid years
  filter(diff_mean_precovid_postcovid <= -1)

hb_specialty %>% 
  filter(specialty != "All",
         hb_name != "All Scotland") %>% 
  group_by(hb_name, specialty, is_winter, admission_type) %>% 
  summarise(mean_admissions_covid = mean(number_admissions),
            mean_admissions_precovid = mean(average20182019),
            #get diff in means precovid vs during covid
            diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid) %>% 
  #see only observations where the mean admissions increased during covid years
  filter(diff_mean_precovid_postcovid <= -1)

For the average 20182019 admissions, certain specialties saw an increase in average number of emergency admissions per week during the winter period. These were: -Medical (both including and exluding Cardiology and Cancer) -Pediatrics (both including and exluding Cardiology and Cancer)

These same increases actually lessened during the Covid years 2020/2021/2022 to the point where there was only a small increase during the winter months. During the Covid years, there was a slight increase in average number of emergency admissions per week for Cardiology and for Surgery, which is notable because average emergency surgery admissions actually decreased in the winter pre-Covid

#get line graph of average number of admissions over time for each specialty

hb_specialty %>% 
  filter(admission_type == "Emergency",
         specialty != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, week_ending, specialty) %>% 
  summarise(mean_admissions = mean(number_admissions)) %>% 
  ggplot() +
    geom_line(aes(x = week_ending,
                  y = mean_admissions, 
                  colour = specialty)) +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
   geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4)+
  geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4)+
  geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4)+
  labs(x = "Date",
       y = "Average number of admissions per week",
       colour = "Specialty")

hb_specialty %>% 
  filter(admission_type == "Emergency",
         specialty != "All", 
         hb_name == "All Scotland") %>% 
  group_by(hb_name, month, specialty) %>% 
  summarise(mean_20182019_admissions = mean(average20182019)) %>% 
  ggplot() +
  geom_point(aes(x = month,
                  y = mean_20182019_admissions, 
                  colour = specialty)) +
    geom_line(aes(x = month,
                  y = mean_20182019_admissions, 
                  colour = specialty), group = hb_specialty$specialty) +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
  labs(x = "Date",
       y = "Average number of admissions per week",
       colour = "Specialty")

HSCP Age/sex dataset

Variables in dataset

hscp_agesex <- read_csv("raw_data/covid_raw_data/hospital_admissions_hscp_agesex_20220302.csv") %>% clean_names()

hscp_agesex %>% names()

Again, the HSCP code is not very helpful, it would be more useful to have the HSCP names and the HB they are tied to.

#read in hscp names dataset
hscp_names <- read_csv("raw_data/covid_raw_data/hscp_names.csv") %>% clean_names()

#select the variables we need to add to the main table
hscp_names <- hscp_names %>% 
  select(hscp, hscp_name, hb, hb_name)

#join with hscp_names to get hscp and hb names

hscp_agesex <- hscp_agesex %>% left_join(hscp_names, by = "hscp")

Check to see if hb and hscp datasets are interchangable

I noticed that HSCP and HB datasets contained the same variables and HSCP datasets contained the HB as well, so I thought that they might be interchangable since, in theory, when you group HSCP datasets by HB, the number of admissions should aggregate to the same numbers as the HB datasets since they are for the same time periods. This isn’t the case. The HSCP dataset recorded higher numbers of admissions when aggregated by HB and compared with the HB dataset.

#summarise no of admissions by sex/age_group for each HB
hscp_agesex %>% 
  group_by(hb, sex, age_group, admission_type) %>% 
  summarise(total_admissions_by_sex = sum(number_admissions))

#summarise no of admissions by sex/age_group for each HB
hb_agesex %>% 
  group_by(hb, sex, age_group, admission_type) %>% 
  summarise(total_admissions_by_sex = sum(number_admissions))

#check number of admissions in each dataset for a random HB for the same week_ending date
hscp_agesex %>%
  select(week_ending, hb, age_group, sex, admission_type, number_admissions) %>% 
  filter(hb == "S08000015",
         week_ending == "20200105") %>% 
  group_by(week_ending, hb, sex, age_group, admission_type) %>% 
  summarise(total_admissions = sum(number_admissions))

hb_agesex %>%
  select(week_ending, hb, age_group, sex, admission_type, number_admissions) %>%
  filter(hb == "S08000015",
         week_ending == "2020-01-05") %>% 
  group_by(week_ending, hb, sex, age_group, admission_type) %>% 
  summarise(total_admissions = sum(number_admissions))

We should ask which dataset should be considered “correct” - I would suggest selecting the HSCP datasets b/c the numbers are higher, which makes me think that some admissions weren’t recorded in the HB dataset.

Can we get the proportion for no of admissions to population in each HB or HSCP? This would allow us to carry out statistical tests to see if any HBs or HSCPs have a higher proportion of admissions compared with Scotland overall

A&E attendance

ae_wait_times <- read_csv("raw_data/non_covid_raw_data/monthly_ae_waitingtimes_202206.csv") %>% clean_names()

Variables in dataset

ae_wait_times %>% names()

ae_wait_times %>% distinct(hbt) # note: need to join hb names

ae_wait_times %>% filter(is.na(number_meeting_target_aggregate))

#select only variables needed for summary table
ae_attendance_summary <- ae_wait_times %>% 
  select(month, hbt, number_of_attendances_aggregate, 
         discharge_destination_admission_to_same,
         discharge_destination_other_specialty,
         discharge_destination_residence,
         discharge_destination_transfer,
         discharge_destination_unknown)

#create separate month and year columns
ae_attendance_summary <- ae_attendance_summary %>% 
  mutate(month_year = month, .before = month)

ae_attendance_summary <- ae_attendance_summary %>% 
  mutate(month = month(ym(month_year), label = TRUE),
         year = year(ym(month_year)), .after = month_year)

#join with hb_names

ae_attendance_summary <- ae_attendance_summary %>% 
  left_join(hb_names, by = c("hbt" = "hb"))

#make all scotland attendance table
all_scotland_attendance <- ae_attendance_summary %>% 
  group_by(year, month) %>% 
  filter(year >= 2017) %>% 
  summarise(num_attendances = sum(number_of_attendances_aggregate),
            admission_to_same = sum(discharge_destination_admission_to_same, na.rm = TRUE),
            other_specialty = sum(discharge_destination_other_specialty, na.rm = TRUE),
            residence = sum(discharge_destination_residence, na.rm = TRUE),
            transfer = sum(discharge_destination_transfer, na.rm = TRUE),
            unknown = sum(discharge_destination_unknown, na.rm = TRUE))

#get proportions for destinations
all_scotland_attendance <- all_scotland_attendance %>% 
  rowwise() %>% 
  mutate(
    total_avg_discharge = sum(c(admission_to_same, other_specialty,
                                residence, transfer, unknown)),
    prop_admission = admission_to_same/total_avg_discharge,
    prop_other_specialty = other_specialty/total_avg_discharge,
    prop_residence = residence/total_avg_discharge,
    prop_transfer = transfer/total_avg_discharge,
    prop_unknown = unknown/total_avg_discharge
  )

ae_attendance_summary <- ae_attendance_summary %>% 
  group_by(hb_name, year, month) %>% 
  summarise(num_attendances = sum(number_of_attendances_aggregate),
           admission_to_same = sum(discharge_destination_admission_to_same, na.rm = TRUE),
            other_specialty = sum(discharge_destination_other_specialty, na.rm = TRUE),
            residence = sum(discharge_destination_residence, na.rm = TRUE),
            transfer = sum(discharge_destination_transfer, na.rm = TRUE),
            unknown = sum(discharge_destination_unknown, na.rm = TRUE))

ae_attendance_summary <- ae_attendance_summary %>% 
  rowwise() %>% 
  mutate(
    total_avg_discharge = sum(c(admission_to_same, other_specialty,
                                residence, transfer, unknown)),
    prop_admission = admission_to_same/total_avg_discharge,
    prop_other_specialty = other_specialty/total_avg_discharge,
    prop_residence = residence/total_avg_discharge,
    prop_transfer = transfer/total_avg_discharge,
    prop_unknown = unknown/total_avg_discharge
  )

#add columns to all scotland
all_scotland_attendance <- all_scotland_attendance %>% 
  mutate(hb_name = "All Scotland")

#select relevant columns
ae_attendance_summary <- ae_attendance_summary %>% 
  filter(year >=2017) %>% 
  select(year, month, hb_name, num_attendances, prop_admission, 
         prop_other_specialty, prop_residence, prop_transfer, prop_unknown)

all_scotland_attendance <- all_scotland_attendance %>% 
  select(year, month, hb_name, num_attendances, prop_admission,
         prop_other_specialty, prop_residence, prop_transfer, prop_unknown)

#bind rows
ae_attendance_summary <- ae_attendance_summary %>% 
  bind_rows(all_scotland_attendance)

#separate dataset into preCovid and Covid year ranges

covid_ae_attendance <- ae_attendance_summary %>% 
  filter(year >= 2020)

precovid_ae_attendance <- ae_attendance_summary %>% 
  filter(year < 2020)

#get 2017-2019 avgs to add as comparator to covid dataset

precovid_ae_attendance <- precovid_ae_attendance %>% 
  group_by(hb_name, month) %>% 
  summarise(avg_attendances_20171819 = mean(num_attendances),
            avg_prop_admission_20171829 = mean(prop_admission),
            avg_prop_other_specialty_20171819 = mean(prop_other_specialty),
            avg_prop_residence_20171819 = mean(prop_residence),
            avg_prop_transfer_20171819 = mean(prop_transfer),
            avg_prop_unknown_20171819 = mean(prop_unknown)) 

#create key to join with covid_ae_attendance
precovid_ae_attendance <- precovid_ae_attendance %>% 
  mutate(hb_key = paste0(hb_name, "_", month), .before = hb_name)

#select only key and avg variables
precovid_ae_attendance <- precovid_ae_attendance %>% 
  subset(select = -c(hb_name, month))

  

covid_ae_attendance <- covid_ae_attendance %>% 
  mutate(hb_key = paste0(hb_name, "_", month), .before = hb_name)

covid_ae_attendance <- covid_ae_attendance %>% 
  left_join(precovid_ae_attendance, by = "hb_key")

covid_ae_attendance <- covid_ae_attendance %>% 
  mutate(date = (paste0(year, "-", month)), .before = year) %>% 
  mutate(date = ym(date), .before = year)

#put data in long format

covid_ae_attendance <- covid_ae_attendance %>% 
  pivot_longer(
    cols = starts_with("prop"),
    names_to = "destination",
    values_to = "destination_prop"
  )

covid_ae_attendance <- covid_ae_attendance %>% 
  mutate(
    avg_prop_20171819 = case_when(
      destination == "prop_admission" ~ avg_prop_admission_20171829,
      destination == "prop_other_specialty" ~ avg_prop_other_specialty_20171819,
      destination == "prop_residence" ~ avg_prop_residence_20171819,
      destination == "prop_transfer" ~ avg_prop_transfer_20171819,
      destination == "prop_unknown" ~ avg_prop_unknown_20171819
    )
  )

covid_ae_attendance <- covid_ae_attendance %>% 
  select(date, year, month, hb_key, hb_name, num_attendances, 
         avg_attendances_20171819, destination,
         destination_prop, avg_prop_20171819)

Graphs for dashboard

covid_ae_attendance_plotly <- covid_ae_attendance %>% 
  filter(hb_name == "All Scotland") %>% 
  ggplot() +
  geom_point(aes(x = date,
                 y = num_attendances,
                 text = paste0("Date: ", year, "-", month,
                              "<br>",
                   "Number of admissions: ", num_attendances,
                 "<br>",
                 "2017-2019 avg admissions: ", 
                 round(avg_attendances_20171819)))) +
  geom_line(aes(x = date,
                y = num_attendances)) +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
   geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4, colour = "grey50")+
  geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4, colour = "grey50")+
  geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4, colour = "grey50")+
  labs(title = "Number of attendances at A&E 2020 - 2022 \n",
       x = "Date",
       y = "Number of Attendances")

Warning: Ignoring unknown aesthetics: text

covid_ae_attendance_plotly %>% 
  ggplotly(tooltip = "text") %>% 
  config(displayModeBar = FALSE) %>% 
  layout(hoverlabel = list(bgcolor = "white"))

covid_ae_destinations_plotly <- covid_ae_attendance %>% 
  filter(hb_name == "All Scotland") %>% 
  ggplot() +
  geom_point(aes(x = date,
                 y = destination_prop,
                 colour = destination,
                 text = paste0("Date: ", year, "-", month,
                               "<br>",
                               "Percentage: ", 
                              round(destination_prop*100, digits = 2), 
                              "%",
                              "<br>",
                              "2017-2019 percentage: ", 
                              round(avg_prop_20171819*100, digits = 2), 
                              "%"))) +
  geom_line(aes(x = date,
                 y = destination_prop,
                group = destination)) +
  scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
  scale_y_sqrt() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
   geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4, colour = "grey50")+
  geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4, colour = "grey50")+
  geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4, colour = "grey50")+
  labs(title = "Destination of attendances at A&E 2020 - 2022 \n",
       x = "Date",
       y = "Proportion of attendances",
       colour = "Destination")

Warning: Ignoring unknown aesthetics: text

covid_ae_destinations_plotly %>% 
  ggplotly(tooltip = "text") %>% 
  config(displayModeBar = FALSE)

NA
NA

Waiting times - Lloyd’s graph

Read data, manipulate table

waiting_times <- read_csv("raw_data/non_covid_raw_data/monthly_ae_waitingtimes_202206.csv") %>% clean_names()

Rows: 15837 Columns: 25-- Column specification -------------------------------------------------------------------------------------------
Delimiter: ","
chr (13): Country, HBT, TreatmentLocation, DepartmentType, NumberOfAttendancesEpisodeQF, NumberMeetingTargetEpi...
dbl (12): Month, NumberOfAttendancesAggregate, NumberOfAttendancesEpisode, NumberMeetingTargetAggregate, Number...
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.

#get date and quarter values 
waiting_times <- waiting_times %>% 
  mutate(date = ym(month),
         quarter = quarter(date))

#get proportions for all destinations
waiting_times <- waiting_times %>% 
  mutate(
    prop_admission_to_same = (discharge_destination_admission_to_same/number_of_attendances_aggregate)
  ) %>% 
  mutate(prop_other_speciality = (discharge_destination_other_specialty/number_of_attendances_aggregate)) %>% 
  mutate(prop_residence = (discharge_destination_residence/number_of_attendances_aggregate)) %>% 
  mutate(prop_transfer = (discharge_destination_transfer/number_of_attendances_aggregate)) %>% 
  mutate(prop_unknown = (discharge_destination_unknown/number_of_attendances_aggregate)) 

#change to long format
waiting_times <- waiting_times %>%
  pivot_longer(cols = prop_admission_to_same:prop_unknown, names_to = "discharge_destination", values_to = "discharge_proportion")

#clean up values for destinations
waiting_times <- waiting_times %>%
  mutate(discharge_destination = case_when(
    str_detect(discharge_destination, "prop_admission_to_same") ~ 
      "Admission to Same Facility",
    str_detect(discharge_destination, "prop_other_speciality") ~ 
      "Discharged to private provider/died",
    str_detect(discharge_destination, "prop_residence") ~ 
      "Discharged to private residence",
    str_detect(discharge_destination, "prop_transfer") ~ 
      "Transferred to another NHS provider",
    str_detect(discharge_destination, "prop_unknown") ~ 
      "Unknown or other discharge destination"
  ))

Graphs for dashboard

#read in clean data
waiting_times <- read_csv("clean_data/wait_times.csv")

Rows: 79185 Columns: 29-- Column specification ------------------------------------------------------------------------------------------
Delimiter: ","
chr  (14): country, hbt, treatment_location, department_type, number_of_attendances_episode_qf, number_meeting...
dbl  (14): month, number_of_attendances_aggregate, number_of_attendances_episode, number_meeting_target_aggreg...
date  (1): date
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.

winter_plotly <- waiting_times %>% 
  filter(discharge_destination == "Admission to Same Facility",
         !is.na(discharge_proportion)) %>% 
  group_by(date) %>% 
  summarise(mean_admission_to_same = mean(discharge_proportion)) %>% 
  ggplot() +
  geom_point(aes(x = date,
         y = mean_admission_to_same,
         text =  paste0("Date: ", date,
                               "<br>",
                               "Percentage: ", 
                              round(mean_admission_to_same*100, digits = 2), 
                              "%"))) +
  geom_line(aes(x = date,
         y = mean_admission_to_same)) +
  scale_x_date(date_breaks = "6 months", date_labels =  "%b %Y") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
  geom_vline(xintercept = as.numeric(as.Date("2008-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2009-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2010-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2011-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2012-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2013-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2014-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2015-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2016-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2017-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2018-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2019-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
  geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4, colour = "grey50", alpha = 0.7) +
  labs(title = "Proportion of attendances to selected destination \n",
       x = "\n Date",
       y = "Proportion of attendances")

Warning: Ignoring unknown aesthetics: text

winter_plotly %>% 
  ggplotly(tooltip = "text") %>% 
  config(displayModeBar = FALSE) %>% 
layout(hoverlabel = list(bgcolor = "white"))

NA